昔は人気なかったやつが人気でたり、逆だったり、の極端なやつらをいくつか経時的に追ってったほうがいい気がしてきた。 そういうやつを見つけてみよう:
relativeなrankをつくって、その変動が大きいものをみつけるか。ずっとRankが低い・高いやつをハイライトするのもよさそう
一番大きなrankから一番小さなRankにいっている(栄枯盛衰のうち栄転)
一番小さなrankから一番大きなRankにいっている(栄枯盛衰のうち転落)
大→小→大 (一時期すごかった、はやり)
小→大→小 (カムバック)
ずっとちいさなRank(ずっと栄光)
ずっと大きなRank(不人気) くらいがとれると面白そう どうやるの relative_rankが…
na.omitしたrankが平均して一番小さい 1.na.omitしたrankが平均して一番大きい…?
COUNT ABSENT
でてくるポケモンではなく、でてこないポケモンに着目してみる。 でてこないポケモンの数もシミュレーションと違う。 prepare all possible entries of pokemons, in that specific era. for example, pokedex 152, gen 2 pokemon cannot appear in game_gen_era == 1 period.
# empty_rank_df <-
# tibble(
# pokedex_id = map(
# .x = 1:8,
# ~ 1:df_game_gen$pokemon_cumulative_n[.x]
# ) |>
# unlist(),
# game_gen_era = map(
# .x = 1:8,
# ~ rep(.x, df_game_gen$pokemon_cumulative_n[.x])
# ) |>
# unlist()
# ) |>
# left_join(df_names, by = "pokedex_id")
df_no_appearance_empは名前つき。どの名前/pokedex_idのやつが欠けているのかがわかる。
df_no_appearance_emp <-
# df_view <-
temporal_change_per_gen_df |>
filter(condition == "pokemon name") |>
# right_join(empty_rank_df) |>
filter(n == 0) |>
count(game_gen_era, pokedex_id, pokemon_name, pokemon_name_ja, across(), name = "count_no_shows")
df_no_appearance_emp |>
ggplot(aes(x = game_gen_era, pokedex_id)) +
# geom_point() +
geom_text(
aes(label = pokemon_name),
size = 6 * pt_convert
)
↑たとえばgame_gen_era == 1 のころには151のミュウだけカードが一度も登場してない。アンノーンにいたっては一時期ものすごく多かったのに、ゼロになってる。ほんとかよ?第2世代の時期で最も多く(1位)、第3世代でゼロ枚、第4世代でまた一位…?まじ?
df_gene |>
filter(pokemon_name == "Unown") |>
count(release_date) |>
ggplot(aes(x = release_date, n)) +
geom_col() +
geom_vline(
data = df_game_gen,
aes(xintercept = game_release_date),
inherit.aes = FALSE
)
Warning: Ignoring unknown parameters: inherit.aes
たしかにぽっかりあいてますね…。
game_gen_era == 8ともなると非常にポケモンが多いので一度も登場していないカードも相当ありそう。
これもかなりランダムとは違う気がするし、測れる気がする。
↓とりあえずシミュレーションで一度も登場しなかったポケモンの名前をrun==1に限定してプロットしてみる。
↑当然といえば当然なんだけどまんべんなく登場しないポケモンがでてくる。さっきのEmpデータとは大違いである。
Game-gen-eraごとに集計して、その数がどれくらいシミュレーションと違うかみてみよう ただしrunすべてについて行うので、right_joinが全部に起きないといけないので難しそう
df_no_appearance_sim <- temporal_change_per_gen_df |>
filter(condition == "simulations") |>
filter(n == 0) |>
count(run, game_gen_era, pokemon_gen, name = "count_no_shows") |>
mutate(condition = "simulations")
df_no_appearance_emp2は名前の情報なく、とにかくどの世代のポケモンがそれぞれの時期に何人登場していないかがわかる。すべてのありうる組み合わせについて集計したいので、completeと直後のfilterでなんとかした。もっと集計すれば、それぞれの時期に(世代関係なく)何人登場していないかデータになるだろうけど、一旦ここで止めている。
# align emp data to match with sim df
df_no_appearance_emp2 <-
# df_view <-
df_no_appearance_emp |>
count(game_gen_era, pokemon_gen, name = "count_no_shows") |>
complete(
game_gen_era = 1:8,
pokemon_gen = 1:8,
fill = list(
count_no_shows = 0
)
) |> # create all combinations
filter(game_gen_era >= pokemon_gen) |> # filter out impossible, excessive combos
mutate(condition = "pokemon name")
いくら第3世代登場直後でも確率的には、ランダムにとれば少しは登場しない奴らがいてもおかしくないのに、全然「一回も登場しないようなポケモンがいない」ということで、正の新奇バイアス…というか、Debutant Biasの傍証といえましょう。第5世代がでるころともなるとその御利益もなくなり、かなりの数が未登場。 ちょっとポケモンじたいの世代は忘れて、時期ごとのAbsenteeの数だけでみてみましょう:
# summarise by game_gen_era only
df_no_appearance2 <- bind_rows(
df_no_appearance_emp2, df_no_appearance_sim
) |>
group_by(game_gen_era, condition, run) |>
summarise(sum = sum(count_no_shows)) |>
ungroup() |>
complete(game_gen_era, condition, fill = list(sum = 0))
`summarise()` has grouped output by 'game_gen_era', 'condition'. You can override using the `.groups` argument.
Era1においてsimパンドラ数が偶数だけ?ってのはおかしい気がするんですが。実際empでは1だし。
偶数だけですね…。
全部みごとに重複してますね。ほかのgame_gen_eraならないのだろうか:
重複ないですね。
もう一度temporal_change_per_gen_dfを計算し直したらうまくいった。後でこの部分は消す。
第4世代までは全部登場させるようなバイアスがかかっていて、5世代以降はかなり「もう諦めようぜ、もう多すぎだから全部作ろうと思わないでいいよ」みたいになってることが一目瞭然である。もちろん5世代目以降はランダムでも多いのであれだけど、ランダムの値からのハズレをみても。
紀要載せたいなー rbind trick
p_no_appearance <-
df_no_appearance_summary |>
ggplot(aes(x = game_gen_era, y = mean_count_no_shows, colour = condition)) +
geom_violin(
data = df_no_appearance_sim,
aes(group = game_gen_era, y = count_no_shows),
scale = "count",
fill = pokemon_yellow |> lighten(0.6),
colour = "transparent",
bw = .5,
trim = FALSE
) +
geom_line(
size = .5
) +
geom_point(
size = .5,
# stroke = .05
) +
scale_colour_manual(
values = c("pokemon name" = pokemon_blue, "simulations" = pokemon_yellow)
) +
scale_x_continuous(
breaks = 1:8,
labels = rbind("", 1:4 * 2) |> c()
) +
# scale_y_continuous(trans = "log10")
facet_wrap(
vars(pokemon_gen),
nrow = 1,
scales = "free",
labeller = pokemon_gen_labeller
) +
theme_pokemon +
theme(
# aspect.ratio = 1,
# legend.position = "none"
)
ggsave("./output/p_count_absent.png", width = 166, height = 166/4, unit = "mm", dpi = 600)
ggsave("./output/p_count_absent.pdf", width = 166, height = 166/4, unit = "mm", dpi = 600)
df_no_appearance_residual <- full_join(
df_no_appearance_emp2 |> select(-condition), df_no_appearance_sim |> select(-condition), by = c("game_gen_era", "pokemon_gen")
) |>
mutate(count_no_shows.x = replace_na(count_no_shows.x, 0)) |>
rename(empirical = "count_no_shows.x", simulations = "count_no_shows.y") |>
mutate(residual = empirical - simulations)
df_no_appearance_residual |>
# filter(condition == "simulations") |>
ggplot(aes(x = game_gen_era, y = residual, colour = pokemon_gen - game_gen_era)) +
geom_hline(yintercept = 1, colour = "blue", alpha = .4) +
geom_jitter(size = .3, alpha = .3) +
scale_colour_viridis_c() +
theme_pokemon
これはプロットが難しいな…ggridgesするときがきた?
第4世代までは新しく登場したばかりのポケモンも昔からのポケモンも大した差はなく平等にとられていた(し、ランダムよりもずっとあますところなくとられていた)が、第5世代では明らかに第5世代が優遇されており、そのアオリを昔の世代たちがくっている
ここ以降は微妙でした
average_relative_rank全Eraつうじてのランクの高さ。数値が低いほど上位を維持している。人気どあい。0.5以上であれば中央以上に人気といっていい。多分。
rank()関数じたいは少ないほうから順にランク1位!としてしまう。nが多いほどランクが上位(小さい)になってほしいので、ここを参考に逆にする。
decline_and_fall_of_pokemon_empire_df <- temporal_change_per_gen_df |>
filter(run == 1 | is.na(run)) |>
filter(condition %in% c("pokemon name", "simulations")) |>
# right_join(empty_rank_df) |>
group_by(condition, run, game_gen_era) |>
# arrange(desc(n)) |>
# mutate(n = replace_na(n, 0)) |> # NAを放置すると次のrank()でNAのやつらの順位が一緒にならん
mutate(rank = rank(-n, ties.method = "min")) |> # higher n -> smaller rank with -n
# mutate(rank = rank(-n, ties.method = "random")) |> # higher n -> smaller rank with -n
ungroup() |>
select(condition, run, game_gen_era, pokemon_gen, pokedex_id,n, rank, ecdf, ) |>
group_by(condition, run, game_gen_era) |>
mutate(relative_rank = rank/max(rank, na.rm = TRUE)) |>
filter(!is.na(relative_rank)) |>
ungroup() |>
group_by(condition, run, pokedex_id) |>
mutate(
average_relative_rank = ave(relative_rank, na.rm = TRUE), # 5., 6.
# delta =
) # 30 sec
decline_and_fall_of_pokemon_empire_df # 8731 x 10
decline_and_fall_of_pokemon_empire_df |>
ggplot(aes(y = relative_rank, x = pokedex_id, colour = condition)) +
geom_point()
なんでPokedex_idによって変な線が見えるんじゃー!面白いけど絶対なんかの都合なので取り除く。→鳥のアゾけましたね minでもrandomでも取り除けた。randomとminで違いすぎやろ。まあminがよかろう。
decline_and_fall_of_pokemon_empire_df |>
ggplot(aes(x = game_gen_era, y = relative_rank, group = pokedex_id, colour = pokedex_id)) +
geom_line() +
geom_point() +
facet_grid(
cols = vars(pokemon_gen),
rows = vars(condition),
scales = "free"
) +
theme_pokemon
# scale_y_continuous(trans = "log10")
# ggsave("./output/p_emp_decline_journey.svg", width = 166, height = 90, unit = "mm", dpi = 1200)
まずは平均的な、全期をつうじての人気、average_relative_rankでやってみるか…
Aveでいいのかわからんし、relativeでいいのかもわからん、なんもわからん
Gen8のものはあまりにサンプルサイズが少ないので(Averageの意味がないので)除く。
setting pch = 21 points
colour = "transparent" is better better than setting
stroke = 0, source
p_average_relative_rank <-
decline_and_fall_of_pokemon_empire_df |>
filter(pokemon_gen < 8) |>
select(average_relative_rank, pokedex_id) |>
distinct() |>
left_join(df_names, by = "pokedex_id") |>
ggplot(aes(x = pokemon_gen, y = average_relative_rank, colour = condition)) +
geom_quasirandom(
dodge.width = .8,
alpha = .7,
colour = "transparent",
stroke = 0,
pch = 21, aes(fill = condition)) +
geom_smooth(se = FALSE) +
scale_colour_manual(
values = c("pokemon name" = pokemon_blue, "simulations" = pokemon_yellow)
) +
scale_fill_manual(
values = c("pokemon name" = pokemon_blue, "simulations" = pokemon_yellow)
) +
labs(
x = "Pokémon Generation",
y = "Average Relative Rank",
) +
facet_grid(
cols = vars(condition)
) +
theme_pokemon +
theme(
legend.position = "none"
)
Adding missing grouping variables: `condition`, `run`
ちょっと最近のやつに甘すぎる基準ですねこれは…。 振り幅でかいやつは誰だ→0からいきなり1位とかになったやつに決まっているので微妙やな とはいえ、Simと比べるとずいぶん傾向がある。ようにも思う。とにかく基準がちょっと適当というか、とりあえず作ったものだからなんともいえんな。rankじゃだめかなあ ふつうにnでやってもいいかも。標準化して…。
やっぱり振り幅の合計かなー ジャーニーがよ
decline_and_fall_of_pokemon_empire_df2 <-
decline_and_fall_of_pokemon_empire_df |> # click game_gen_era, pokedex_id then condition
ungroup() |>
group_by(condition, pokedex_id) |>
mutate(
previous_relative_rank = lead(relative_rank, order_by = game_gen_era),
delta = relative_rank - previous_relative_rank,
sum_delta = sum(abs(delta), na.rm = TRUE), # total journey
ave_sum_delta = sum_delta / ( 8 - pokemon_gen) # average journey per game gen change
) |>
select(pokemon_gen, pokedex_id, ave_sum_delta) |>
distinct()
Adding missing grouping variables: `condition`
なんかあかんわ
decline_and_fall_of_pokemon_empire_df3 <-
decline_and_fall_of_pokemon_empire_df2 |>
ungroup() |>
group_by(condition, game_gen_era) |>
mutate(standardized_n = n / max(n)) |>
ungroup() |>
group_by(condition, pokedex_id) |>
mutate(avg_std_n = ave(standardized_n))
Error in `group_by()`:
! Must group by variables found in `.data`.
✖ Column `game_gen_era` is not found.
Backtrace:
1. dplyr::mutate(...)
6. dplyr:::group_by.data.frame(ungroup(decline_and_fall_of_pokemon_empire_df2), condition, game_gen_era)
decline_and_fall_of_pokemon_empire_df3 |>
select(ave_sum_delta, avg_std_n, pokemon_gen) |>
distinct() |>
ggplot(aes(ave_sum_delta, avg_std_n, colour = pokemon_gen)) +
geom_point(size = 1, alpha = .3) +
scale_colour_viridis_c() +
facet_wrap(
vars(pokemon_gen)
)
もうあかんわ。こういうのじゃなくて、とりあえずプロットでハイライトするポケモンを決めたいだけなので、やっぱり各時代の3位くらいまでの動向を調べるだけでかなりいいと思う。 少なくとも1つ、rankが3以下の行を含むグループを返す、というのはkoreでできると思う。
decline_and_fall_of_pokemon_empire_df3_background <- decline_and_fall_of_pokemon_empire_df3 |>
filter(condition == "pokemon name") |>
ungroup() |>
select(n, pokedex_id, game_gen_era, pokemon_gen) |> distinct()
# df_top_pokemon <-
# decline_and_fall_of_pokemon_empire_df3 |>
# ungroup() |>
# group_by(condition, pokedex_id) |>
# filter(any(rank <= 1)) |>
# # filter(pokedex_id %in% top_three$pokedex_id & condition == )
# left_join(df_names, by = c("pokedex_id", "pokemon_gen")) |>
# filter(condition == "pokemon name")
df_top_pokemon |>
ggplot(aes(x = game_gen_era, y = n)) +
geom_quasirandom(
data = decline_and_fall_of_pokemon_empire_df3_background,
aes(colour = pokemon_gen, group = pokemon_gen |> as.factor()),
size = .2,
dodge.width = .8
) +
geom_line(aes(colour = pokemon_gen, group = pokedex_id,), size = .3, alpha = .5) +
geom_image(aes(image = image_large), height= .05, by = "width", asp = 1.5) +
# scale_size_identity() +
geom_text_repel(
aes(label = paste0(pokemon_name, ":r=", rank, "n=", n)),
min.segment.length = 0,
family = "Rotis SemiSans Std Light",
segment.size = .1,
max.overlaps = 50,
size = 3 * pt_convert,
hjust = 0
) +
scale_colour_viridis_c() +
facet_wrap(vars(condition)) +
scale_y_continuous(trans = "log10") +
theme_pokemon +
theme(
aspect.ratio = 1/1.5,
legend.position = "none")
ggsave("./output/p_emp_vs_sim_top_three_decline_and_fall.svg", height = 80, width = 80 * 1.5, units = "mm")